home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TSPA3455 / TSUNTI.TST < prev    next >
Text File  |  1993-01-22  |  5KB  |  158 lines
  1. (* This is a test program for the TSUNTI.TPU unit 6-Aug-90,
  2.    23-Jan-93
  3.  
  4. IMPORTANT ADVICE: Study these tests and the information in TSUNTI.INT
  5. carefully before writing your own applications. The routines in the
  6. TSUNTI.TPU unit are much more complicated than any of the others.
  7.  
  8. *)
  9.  
  10. uses Dos,
  11.      TSUNTI
  12.      {$IFDEF VER40}
  13.      ,TSUNT45
  14.      {$ENDIF}
  15.      ;
  16.  
  17. procedure LOGO;
  18. begin
  19.   writeln;
  20.   writeln ('TSUNTI unit test by Prof. Timo Salmi, 23-Jan-93');
  21.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  22. {$IFDEF VER40}
  23.   writeln ('TP version 4.0');
  24. {$ENDIF}
  25. {$IFDEF VER50}
  26.   writeln ('TP version 5.0');
  27. {$ENDIF}
  28. {$IFDEF VER55}
  29.   writeln ('TP version 5.5');
  30. {$ENDIF}
  31. {$IFDEF VER60}
  32.   writeln ('TP version 6.0');
  33. {$ENDIF}
  34. {$IFDEF VER70}
  35.   writeln ('TP version 7.0');
  36. {$ENDIF}
  37.   writeln;
  38. end;  (* logo *)
  39.  
  40. (* Get the number of times this program has been run since last
  41.    compiled. Run this test a few times, and see the count increase *)
  42. procedure TEST1;
  43. var status : string;
  44.     count  : longint;
  45. begin
  46.   USECOUNT (count, status);
  47.   if status = '' then
  48.     writeln ('This program has been run ', count, ' times since compilation')
  49.   else
  50.     writeln ('Status of usecount ', status);
  51. end;  (* test1 *)
  52.  
  53. (* Get the number of times this program has been run since last compiled.
  54.    Run this test a few times, and see the counter increase. Then recompile,
  55.    and see the counter being initialized. Nifty, isn't it. *)
  56. procedure TEST2;
  57. const counter : longint = 0;
  58. var status : word;
  59. begin
  60.   counter := counter + 1;
  61.   BRANDEXE (counter, SizeOf(counter), status);
  62.   if status <> 0 then
  63.     begin writeln ('Error status = ', status); exit; end;
  64.   writeln ('Counter = ', counter);
  65. end;  (* test2 *)
  66.  
  67. (* Here is a more complicted test of BRANDEXE usage. Study it carefully,
  68.    and try out your own variations *)
  69. procedure TEST3;
  70. type MyInfoType = record
  71.                     counter   : longint;
  72.                     hour      : word;
  73.                     minute    : word;
  74.                     second    : word;
  75.                     sec100    : word;
  76.                   end;
  77. const MyInfo
  78.       : MyInfoType
  79.       = (counter : 0;  { These initial values are changed by BRANDEXE. }
  80.          hour    : 0;  { The next time you run this program, the branded }
  81.          minute  : 0;  { values will have replaced these zeros in the .exe }
  82.          second  : 0;
  83.          sec100  : 0);
  84. var status : word;
  85.     hh, mm, ss, s100 : word;
  86. begin
  87.   {... This shows how the counter is used now, but let's comment it away
  88.        this time and concentrate on the run-last-time test ...}
  89.   {
  90.   myinfo.counter := myinfo.counter + 1;
  91.   BRANDEXE (MyInfo, SizeOf(MyInfo), status);
  92.   if status <> 0 then
  93.     begin writeln ('Error status = ', status); exit; end;
  94.   writeln ('Counter = ', myinfo.counter);
  95.   }
  96.   {}
  97.   {... This information is taken from within the .exe ...}
  98.   write ('Last run at ', myinfo.hour, ':');
  99.   if myinfo.minute < 10 then write ('0');
  100.   write (myinfo.minute, ':');
  101.   if myinfo.second < 10 then write ('0');
  102.   writeln (myinfo.second);
  103.   {}
  104.   {... Get the current time ...}
  105.   GetTime (hh, mm, ss, s100);
  106.   write ('The time now ', hh, ':');
  107.   if mm < 10 then write ('0');
  108.   write (mm, ':');
  109.   if ss < 10 then write ('0');
  110.   writeln (ss);
  111.   {}
  112.   {... And now store the current time within the .exe as the MyInfo
  113.        initial values ...}
  114.   myinfo.hour := hh;
  115.   myinfo.minute := mm;
  116.   myinfo.second := ss;
  117.   myinfo.sec100 := s100;
  118.   BRANDEXE (MyInfo, SizeOf(MyInfo), status);
  119.   if status <> 0 then
  120.     writeln ('Branding failed, status : ', status);
  121. end;  (* test3 *)
  122.  
  123. (* How to use the direct checksum *)
  124. procedure TEST4;
  125. type checksumRecordType
  126.         = record
  127.             chksum : longint;
  128.             show   : boolean;
  129.           end;
  130. const checksumRecord
  131.         : checksumRecordType
  132.         = (chksum : 581581;      (* Alter chksum to match your program's *)
  133.            show   : true);       (* Turn false for no display, see below *)
  134. var chksum
  135.       : longint;
  136. begin
  137.   chksum := CHKSUMFN (checksumRecord, SizeOf(checksumRecord));
  138.   if checksumRecord.show then writeln ('CHECKSUM = ', chksum);
  139.   if (chksum <> checksumRecord.chksum) and (chksum <> 0) then
  140.     begin
  141.       {$IFNDEF VER40}
  142.       writeln ('Checksum error in ', paramstr(0));
  143.       {$ELSE}
  144.       writeln ('Checksum error in ', paramstr0);
  145.       {$ENDIF}
  146.     end;
  147. end;  (* test4 *)
  148.  
  149. (* Main program *)
  150. begin
  151.   LOGO;
  152.   TEST4;
  153.   {}
  154.   {... if you want the rest of the tests, just include them ...}
  155.   {}
  156.   write ('Press <═╝'); readln;
  157. end.  (* tsunti.tst *)
  158.